home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / Rkrm / Graphics_Libraries / Sprites_Bobs / vsprite.e < prev   
Encoding:
Text File  |  1995-09-20  |  5.4 KB  |  156 lines

  1. -> vsprite.e - Virtual Sprite example
  2.  
  3. ->>> Header (globals)
  4. MODULE 'dos/dos',
  5.        'exec/memory',
  6.        'exec/ports',
  7.        'graphics/collide',
  8.        'graphics/gels',
  9.        'graphics/rastport',
  10.        'intuition/intuition',
  11.        'intuition/screens',
  12.        'other/ecode',
  13.        '*animtools'
  14.  
  15. ENUM ERR_NONE, ERR_KICK, ERR_WIN
  16.  
  17. RAISE ERR_KICK IF KickVersion()=FALSE,
  18.       ERR_WIN  IF OpenWindow()=NIL
  19.  
  20. CONST GEL_SIZE=4
  21.  
  22. -> VSprite data - there are two sets that are alternated between.  Note that
  23. -> this data is always displayed as low resolution.
  24. DEF vsprite_data1, vsprite_data2, mySpriteColours, mySpriteAltColours
  25. ->>>
  26.  
  27. ->>> PROC vspriteDrawGList(win, myRPort)
  28. -> Basic VSprite display subroutine
  29. PROC vspriteDrawGList(win, myRPort)
  30.   SortGList(myRPort)
  31.   DrawGList(myRPort, ViewPortAddress(win))
  32.   RethinkDisplay()
  33. ENDPROC
  34. ->>>
  35.  
  36. ->>> PROC borderCheck(hitVSprite:PTR TO vs, borderflags)
  37. -> Collision routine for vsprite hitting border.  Note that when the collision
  38. -> is VSprite to VSprite (or Bob to Bob, Bob to AnimOb, etc.), then the
  39. -> parameters are both pointers to a VSprite.
  40. PROC borderCheck(hitVSprite:PTR TO vs, borderflags)
  41.   IF borderflags AND RIGHTHIT
  42.     hitVSprite.sprcolors:=mySpriteAltColours
  43.     hitVSprite.vuserext:=-40
  44.   ENDIF
  45.   IF borderflags AND LEFTHIT
  46.     hitVSprite.sprcolors:=mySpriteColours
  47.     hitVSprite.vuserext:=20
  48.   ENDIF
  49. ENDPROC
  50. ->>>
  51.  
  52. ->>> PROC process_window(win:PTR TO window, myRPort, myVSprite:PTR TO vs)
  53. -> Process window and dynamically change vsprite.  Get messages.  Go away on
  54. -> CLOSEWINDOW.  Update and redisplay vsprite on INTUITICKS.  Wait for more
  55. -> messages.
  56. PROC process_window(win:PTR TO window, myRPort, myVSprite:PTR TO vs)
  57.   DEF msg:PTR TO intuimessage
  58.   LOOP
  59.     Wait(Shl(1, win.userport.sigbit))
  60.     WHILE NIL<>(msg:=GetMsg(win.userport))
  61.       -> Only IDCMP_CLOSEWINDOW and IDCMP_INTUITICKS are active
  62.       IF msg.class=IDCMP_CLOSEWINDOW
  63.         ReplyMsg(msg)
  64.         RETURN
  65.       ENDIF
  66.       -> Must be an INTUITICKS:  change x and y values on the fly.  Note offset
  67.       -> by window left and top edge--sprite is relative to the screen, not
  68.       -> window.  Divide the MouseY in half to adjust for Lores movement
  69.       -> increments on a Hires screen.
  70.       myVSprite.x:=win.leftedge+msg.mousex+myVSprite.vuserext
  71.       myVSprite.y:=win.topedge+(msg.mousey/2)+1
  72.       ReplyMsg(msg)
  73.     ENDWHILE
  74.     -> Got a message, change image data on the fly
  75.     myVSprite.imagedata:=IF myVSprite.imagedata=vsprite_data1 THEN
  76.                             vsprite_data2 ELSE vsprite_data1
  77.     SortGList(myRPort)
  78.     DoCollision(myRPort)
  79.     vspriteDrawGList(win, myRPort)
  80.   ENDLOOP
  81. ENDPROC
  82. ->>>
  83.  
  84. ->>> PROC do_VSprite(win, myRPort:PTR TO rastport) HANDLE
  85. -> Working with the VSprite.  Setup the GEL system and get a new VSprite
  86. -> (makeVSprite()).  Add VSprite to the system and display.  Use the vsprite.
  87. -> When done, remove VSprite and update the display without the VSprite.
  88. -> Cleanup everything.
  89. PROC do_VSprite(win, myRPort:PTR TO rastport) HANDLE
  90.   DEF myVSprite=NIL:PTR TO vs, my_ginfo=NIL
  91.   my_ginfo:=setupGelSys(myRPort, $FC)
  92.   myVSprite:=makeVSprite(
  93.             -> Image data, sprite colour array, word width (1 for true VSprite)
  94.            [vsprite_data1, mySpriteColours, 1,
  95.             -> Line height, image depth (2 for true VSprite), x, y position
  96.             GEL_SIZE, 2, 160, 100,
  97.             -> Flags (VSF_VSPRITE for true VSprite), hit mask and me mask
  98.             VSF_VSPRITE, Shl(1, BORDERHIT), 0]:newVSprite)
  99.   AddVSprite(myVSprite, myRPort)
  100.   vspriteDrawGList(win, myRPort)
  101.   myVSprite.vuserext:=20
  102.   -> E-Note: wrap borderCheck function for use as collision routine
  103.   SetCollision(BORDERHIT, eCodeCollision({borderCheck}), myRPort.gelsinfo)
  104.   process_window(win, myRPort, myVSprite)
  105.   RemVSprite(myVSprite)
  106. EXCEPT DO
  107.   IF myVSprite THEN freeVSprite(myVSprite)
  108.   IF my_ginfo
  109.     vspriteDrawGList(win, myRPort)
  110.     cleanupGelSys(my_ginfo, myRPort)
  111.   ENDIF
  112.   ReThrow()
  113. ENDPROC
  114. ->>>
  115.  
  116. ->>> PROC main() HANDLE
  117. -> Example VSprite program.  First open a window.
  118. PROC main() HANDLE
  119.   DEF win=NIL:PTR TO window, myRPort=NIL:PTR TO rastport
  120.   KickVersion(37)
  121.   NEW myRPort  -> E-Note: allocate a zeroed rastport
  122.   -> E-Note: set-up global data
  123.   vsprite_data1:=copyListToChip([$7FFE80FF, $7C3E803F, $7C3E803F, $7FFE80FF, 0])
  124.   vsprite_data2:=copyListToChip([$7FFEFF01, $7C3EFC01, $7C3EFC01, $7FFEFF01, 0])
  125.   mySpriteColours:=[$0000, $00F0, $0F00]:INT
  126.   mySpriteAltColours:=[$000F, $0F00, $0FF0]:INT
  127.   win:=OpenWindow([80, 20, 400, 150, -1, -1,
  128.                    IDCMP_CLOSEWINDOW OR IDCMP_INTUITICKS,
  129.                    WFLG_ACTIVATE OR WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR
  130.                        WFLG_RMBTRAP OR WFLG_DRAGBAR,
  131.                    NIL, NIL, 'VSprite', NIL, NIL, 0, 0, 0, 0, WBENCHSCREEN]:nw)
  132.   InitRastPort(myRPort)
  133.   -> Copy the window rastport
  134.   CopyMem(win.wscreen.rastport, myRPort, SIZEOF rastport)
  135.   do_VSprite(win, myRPort)
  136. EXCEPT DO
  137.   IF win THEN CloseWindow(win)
  138.   END myRPort
  139.   SELECT exception
  140.   CASE ERR_KICK;  WriteF('Error: requires V37\n')
  141.   CASE ERR_WIN;   WriteF('Error: could not open window\n')
  142.   CASE "MEM";     WriteF('Error: ran out of memory\n')
  143.   ENDSELECT
  144. ENDPROC IF exception<>ERR_NONE THEN RETURN_FAIL ELSE RETURN_OK
  145. ->>>
  146.  
  147. ->>> PROC copyListToChip(data)
  148. -> E-Note: get some Chip memory and copy list (quick, since LONG aligned)
  149. PROC copyListToChip(data)
  150.   DEF size, mem
  151.   size:=ListLen(data)*SIZEOF LONG
  152.   mem:=NewM(size, MEMF_CHIP)
  153.   CopyMemQuick(data, mem, size)
  154. ENDPROC mem
  155. ->>>
  156.